home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / access5g / audiopla.frm (.txt) next >
Encoding:
Visual Basic Form  |  1999-07-12  |  32.0 KB  |  961 lines
  1. VERSION 5.00
  2. Object = "{C1A8AF28-1257-101B-8FB0-0020AF039CA3}#1.1#0"; "MCI32.OCX"
  3. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  4. Begin VB.Form frmAudioPlayer 
  5.    BorderStyle     =   1  'Fixed Single
  6.    Caption         =   "Audio player"
  7.    ClientHeight    =   2775
  8.    ClientLeft      =   2040
  9.    ClientTop       =   1755
  10.    ClientWidth     =   4635
  11.    LinkMode        =   1  'Source
  12.    LinkTopic       =   "Form2"
  13.    LockControls    =   -1  'True
  14.    MaxButton       =   0   'False
  15.    ScaleHeight     =   2775
  16.    ScaleWidth      =   4635
  17.    Begin VB.ComboBox cboTrack 
  18.       BeginProperty Font 
  19.          Name            =   "MS Sans Serif"
  20.          Size            =   8.25
  21.          Charset         =   0
  22.          Weight          =   700
  23.          Underline       =   0   'False
  24.          Italic          =   0   'False
  25.          Strikethrough   =   0   'False
  26.       EndProperty
  27.       Height          =   315
  28.       Left            =   150
  29.       TabIndex        =   15
  30.       Text            =   "Combo1"
  31.       Top             =   1740
  32.       Width           =   645
  33.    End
  34.    Begin VB.CommandButton cmdCDLoad 
  35.       BackColor       =   &H00C0C0FF&
  36.       Caption         =   "~"
  37.       BeginProperty Font 
  38.          Name            =   "MS Sans Serif"
  39.          Size            =   13.5
  40.          Charset         =   0
  41.          Weight          =   700
  42.          Underline       =   0   'False
  43.          Italic          =   0   'False
  44.          Strikethrough   =   0   'False
  45.       EndProperty
  46.       Height          =   345
  47.       Left            =   3900
  48.       Style           =   1  'Graphical
  49.       TabIndex        =   13
  50.       ToolTipText     =   "Load CD"
  51.       Top             =   2190
  52.       Width           =   525
  53.    End
  54.    Begin VB.CommandButton cmdVolInc 
  55.       Caption         =   "+"
  56.       BeginProperty Font 
  57.          Name            =   "MS Sans Serif"
  58.          Size            =   12
  59.          Charset         =   0
  60.          Weight          =   700
  61.          Underline       =   0   'False
  62.          Italic          =   0   'False
  63.          Strikethrough   =   0   'False
  64.       EndProperty
  65.       Height          =   345
  66.       Left            =   3900
  67.       TabIndex        =   11
  68.       Top             =   750
  69.       Width           =   495
  70.    End
  71.    Begin VB.CommandButton cmdVolDec 
  72.       Caption         =   "-"
  73.       BeginProperty Font 
  74.          Name            =   "MS Sans Serif"
  75.          Size            =   13.5
  76.          Charset         =   0
  77.          Weight          =   700
  78.          Underline       =   0   'False
  79.          Italic          =   0   'False
  80.          Strikethrough   =   0   'False
  81.       EndProperty
  82.       Height          =   345
  83.       Left            =   3360
  84.       TabIndex        =   10
  85.       Top             =   750
  86.       Width           =   525
  87.    End
  88.    Begin VB.CommandButton cmdCD 
  89.       BackColor       =   &H00C0C0FF&
  90.       Caption         =   "CD"
  91.       Height          =   345
  92.       Left            =   180
  93.       Style           =   1  'Graphical
  94.       TabIndex        =   6
  95.       Top             =   150
  96.       Width           =   855
  97.    End
  98.    Begin VB.CommandButton cmdMidi 
  99.       BackColor       =   &H00FFFFC0&
  100.       Caption         =   "Midi"
  101.       Height          =   345
  102.       Left            =   1920
  103.       Style           =   1  'Graphical
  104.       TabIndex        =   1
  105.       Top             =   150
  106.       Width           =   855
  107.    End
  108.    Begin VB.CommandButton cmdWave 
  109.       BackColor       =   &H00C0FFFF&
  110.       Caption         =   "Wave"
  111.       Height          =   345
  112.       Left            =   1050
  113.       Style           =   1  'Graphical
  114.       TabIndex        =   0
  115.       Top             =   150
  116.       Width           =   855
  117.    End
  118.    Begin VB.CommandButton cmdExit 
  119.       Caption         =   "Exit"
  120.       BeginProperty Font 
  121.          Name            =   "MS Sans Serif"
  122.          Size            =   8.25
  123.          Charset         =   0
  124.          Weight          =   700
  125.          Underline       =   0   'False
  126.          Italic          =   0   'False
  127.          Strikethrough   =   0   'False
  128.       EndProperty
  129.       Height          =   345
  130.       Left            =   3630
  131.       TabIndex        =   2
  132.       Top             =   150
  133.       Width           =   825
  134.    End
  135.    Begin MCI.MMControl mmControl1 
  136.       Height          =   375
  137.       Left            =   150
  138.       TabIndex        =   3
  139.       ToolTipText     =   "1 Prev/2 Next/3 Play/4 Pause/5 Back/6 Step/7 Stop/8 Record/9 Eject"
  140.       Top             =   2160
  141.       Width           =   4290
  142.       _ExtentX        =   7567
  143.       _ExtentY        =   661
  144.       _Version        =   393216
  145.       BorderStyle     =   0
  146.       DeviceType      =   ""
  147.       FileName        =   ""
  148.    End
  149.    Begin VB.PictureBox picVolume 
  150.       Height          =   405
  151.       Left            =   3330
  152.       ScaleHeight     =   345
  153.       ScaleWidth      =   1035
  154.       TabIndex        =   14
  155.       Top             =   720
  156.       Width           =   1095
  157.    End
  158.    Begin MSComDlg.CommonDialog CommonDialog1 
  159.       Left            =   3660
  160.       Top             =   1380
  161.       _ExtentX        =   847
  162.       _ExtentY        =   847
  163.       _Version        =   393216
  164.       CancelError     =   -1  'True
  165.       DialogTitle     =   "HCL Applications"
  166.       FromPage        =   1
  167.       Max             =   1000
  168.       Min             =   1
  169.       ToPage          =   1
  170.    End
  171.    Begin VB.Label lblVolume 
  172.       Caption         =   "Volume:"
  173.       Height          =   285
  174.       Left            =   2730
  175.       TabIndex        =   12
  176.       Top             =   810
  177.       Width           =   585
  178.    End
  179.    Begin VB.Label lblDurationValue 
  180.       Caption         =   "lblDurationValue"
  181.       Height          =   285
  182.       Left            =   930
  183.       TabIndex        =   9
  184.       Top             =   1380
  185.       Width           =   1275
  186.    End
  187.    Begin VB.Label lblDuration 
  188.       BackColor       =   &H00C0C0C0&
  189.       Caption         =   "Duration:"
  190.       Height          =   255
  191.       Left            =   150
  192.       TabIndex        =   8
  193.       Top             =   1380
  194.       Width           =   675
  195.    End
  196.    Begin VB.Label lblTotalTrack 
  197.       BackColor       =   &H00C0C0C0&
  198.       Caption         =   "Total tracks:"
  199.       Height          =   255
  200.       Left            =   900
  201.       TabIndex        =   7
  202.       Top             =   1770
  203.       Width           =   1425
  204.    End
  205.    Begin VB.Label Label1 
  206.       BorderStyle     =   1  'Fixed Single
  207.       Height          =   405
  208.       Left            =   150
  209.       TabIndex        =   5
  210.       Top             =   120
  211.       Width           =   4335
  212.    End
  213.    Begin VB.Label lblDevice 
  214.       Caption         =   "lblDevice"
  215.       BeginProperty Font 
  216.          Name            =   "MS Sans Serif"
  217.          Size            =   8.25
  218.          Charset         =   0
  219.          Weight          =   700
  220.          Underline       =   0   'False
  221.          Italic          =   0   'False
  222.          Strikethrough   =   0   'False
  223.       EndProperty
  224.       Height          =   255
  225.       Left            =   180
  226.       TabIndex        =   4
  227.       Top             =   810
  228.       Width           =   1365
  229.    End
  230. Attribute VB_Name = "frmAudioPlayer"
  231. Attribute VB_GlobalNameSpace = False
  232. Attribute VB_Creatable = False
  233. Attribute VB_PredeclaredId = True
  234. Attribute VB_Exposed = False
  235. ' AudioPlayer.frm
  236. ' By Herman Liu
  237. ' An audio player with all essential functions; these include
  238. ' (1) adjustment of sound volumes of CD and WAVE; (2) direct
  239. ' selection of any CD track to play; (3) plays CD/WAVE/MIDI.
  240. ' For those who are frustrated for failing to a find a volume
  241. ' control for CD player on the sites and don't know how to
  242. ' make one, this source code shall definitely help).
  243. Private Const conCDInterval = 1000
  244. Private Const MMSYSERR_NOERROR = 0
  245. Private Const MAXPNAMELEN = 32
  246. Private Const MIXER_LONG_NAME_CHARS = 64
  247. Private Const MIXER_SHORT_NAME_CHARS = 16
  248. Private Const MIXER_GETLINEINFOF_COMPONENTTYPE = &H3&
  249. Private Const MIXER_GETCONTROLDETAILSF_VALUE = &H0&
  250. Private Const MIXER_GETLINECONTROLSF_ONEBYTYPE = &H2&
  251. Private Const MIXERLINE_COMPONENTTYPE_DST_FIRST = &H0&
  252. Private Const MIXERLINE_COMPONENTTYPE_SRC_FIRST = &H1000&
  253.       
  254. Private Const MIXERLINE_COMPONENTTYPE_DST_SPEAKERS = _
  255.                (MIXERLINE_COMPONENTTYPE_DST_FIRST + 4)
  256.                      
  257. Private Const MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE = _
  258.                (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 3)
  259.       
  260. Private Const MIXERLINE_COMPONENTTYPE_SRC_LINE = _
  261.                (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 2)
  262.       
  263. Private Const MIXERCONTROL_CT_CLASS_FADER = &H50000000
  264. Private Const MIXERCONTROL_CT_UNITS_UNSIGNED = &H30000
  265. Private Const MIXERCONTROL_CONTROLTYPE_FADER = _
  266.     (MIXERCONTROL_CT_CLASS_FADER Or MIXERCONTROL_CT_UNITS_UNSIGNED)
  267.       
  268. Private Const MIXERCONTROL_CONTROLTYPE_VOLUME = (MIXERCONTROL_CONTROLTYPE_FADER + 1)
  269.       
  270. Private Declare Function mixerClose Lib "WINMM.DLL" (ByVal hmx As Long) As Long
  271.          
  272. Private Declare Function mixerGetLineControls Lib "WINMM.DLL" _
  273.     Alias "mixerGetLineControlsA" (ByVal hmxobj As Long, _
  274.     pmxlc As MIXERLINECONTROLS, ByVal fdwControls As Long) As Long
  275.                      
  276. Private Declare Function mixerGetLineInfo Lib "WINMM.DLL" Alias "mixerGetLineInfoA" _
  277.     (ByVal hmxobj As Long, pmxl As MIXERLINE, ByVal fdwInfo As Long) As Long
  278.                      
  279. Private Declare Function mixerOpen Lib "WINMM.DLL" (phmx As Long, _
  280.     ByVal uMxId As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, _
  281.     ByVal fdwOpen As Long) As Long
  282.                      
  283. Private Declare Function mixerSetControlDetails Lib "WINMM.DLL" _
  284.     (ByVal hmxobj As Long, pmxcd As MIXERCONTROLDETAILS, _
  285.     ByVal fdwDetails As Long) As Long
  286.                      
  287. Private Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" _
  288.     (struct As Any, ByVal ptr As Long, ByVal cb As Long)
  289.                      
  290. Private Declare Sub CopyPtrFromStruct Lib "kernel32" Alias "RtlMoveMemory" _
  291.     (ByVal ptr As Long, struct As Any, ByVal cb As Long)
  292.                      
  293. Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
  294.     ByVal dwBytes As Long) As Long
  295.                      
  296. Private Declare Function GlobalLock Lib "kernel32" (ByVal hmem As Long) As Long
  297.                      
  298. Private Declare Function GlobalFree Lib "kernel32" (ByVal hmem As Long) As Long
  299.       
  300. Private Declare Function waveOutGetVolume Lib "WINMM.DLL" (ByVal uDeviceID As Long, _
  301.      lpdwVolume As Long) As Long
  302.      
  303. Private Declare Function waveOutSetVolume Lib "WINMM.DLL" (ByVal uDeviceID As Long, _
  304.      ByVal dwVolume As Long) As Long
  305.       
  306. Private Type MIXERCAPS
  307.      wMid As Integer                   '  manufacturer id
  308.      wPid As Integer                   '  product id
  309.      vDriverVersion As Long            '  version of the driver
  310.      szPname As String * MAXPNAMELEN   '  product name
  311.      fdwSupport As Long                '  misc. support bits
  312.      cDestinations As Long             '  count of destinations
  313. End Type
  314.       
  315. Private Type MIXERCONTROL
  316.      cbStruct As Long           '  size in Byte of MIXERCONTROL
  317.      dwControlID As Long        '  unique control id for mixer device
  318.      dwControlType As Long      '  MIXERCONTROL_CONTROLTYPE_xxx
  319.      fdwControl As Long         '  MIXERCONTROL_CONTROLF_xxx
  320.      cMultipleItems As Long     '  if MIXERCONTROL_CONTROLF_MULTIPLE set
  321.      szShortName As String * MIXER_SHORT_NAME_CHARS  ' short name of control
  322.      szName As String * MIXER_LONG_NAME_CHARS        ' long name of control
  323.      lMinimum As Long           '  Minimum value
  324.      lMaximum As Long           '  Maximum value
  325.      reserved(10) As Long       '  reserved structure space
  326. End Type
  327.       
  328. Private Type MIXERCONTROLDETAILS
  329.      cbStruct As Long       '  size in Byte of MIXERCONTROLDETAILS
  330.      dwControlID As Long    '  control id to get/set details on
  331.      cChannels As Long      '  number of channels in paDetails array
  332.      item As Long           '  hwndOwner or cMultipleItems
  333.      cbDetails As Long      '  size of _one_ details_XX struct
  334.      paDetails As Long      '  pointer to array of details_XX structs
  335. End Type
  336.       
  337. Private Type MIXERCONTROLDETAILS_UNSIGNED
  338.      dwValue As Long        '  value of the control
  339. End Type
  340.       
  341. Private Type MIXERLINE
  342.      cbStruct As Long               '  size of MIXERLINE structure
  343.      dwDestination As Long          '  zero based destination index
  344.      dwSource As Long               '  zero based source index (if source)
  345.      dwLineID As Long               '  unique line id for mixer device
  346.      fdwLine As Long                '  state/information about line
  347.      dwUser As Long                 '  driver specific information
  348.      dwComponentType As Long        '  component type line connects to
  349.      cChannels As Long              '  number of channels line supports
  350.      cConnections As Long           '  number of connections (possible)
  351.      cControls As Long              '  number of controls at this line
  352.      szShortName As String * MIXER_SHORT_NAME_CHARS
  353.      szName As String * MIXER_LONG_NAME_CHARS
  354.      dwType As Long
  355.      dwDeviceID As Long
  356.      wMid  As Integer
  357.      wPid As Integer
  358.      vDriverVersion As Long
  359.      szPname As String * MAXPNAMELEN
  360. End Type
  361.       
  362. Private Type MIXERLINECONTROLS
  363.      cbStruct As Long       '  size in Byte of MIXERLINECONTROLS
  364.      dwLineID As Long       '  line id (from MIXERLINE.dwLineID)
  365.                             '  MIXER_GETLINECONTROLSF_ONEBYID or
  366.      dwControl As Long      '  MIXER_GETLINECONTROLSF_ONEBYTYPE
  367.      cControls As Long      '  count of controls pmxctrl points to
  368.      cbmxctrl As Long       '  size in Byte of _one_ MIXERCONTROL
  369.      pamxctrl As Long       '  pointer to first MIXERCONTROL array
  370. End Type
  371. Private Const conMCIErrInvalidDeviceID = 30257
  372. Private Const conMCIErrDeviceOpen = 30263
  373. Private Const conMCIErrCannotLoadDriver = 30266
  374. Private Const conMCIErrUnsupportedFunction = 30274
  375. Private Const conMCIErrInvalidFile = 30304
  376. Private Const conWAVEInterval = 50
  377. Private Const conWAVEIntervalPlus = 55
  378. Private Type VOLSETTINGTYPE
  379.     LeftVol As Integer
  380.     RightVol As Integer
  381. End Type
  382. Private Type VOLTYPE
  383.     mWaveVol As Long
  384. End Type
  385. Const VolStelVal = 5000
  386. Const NegStepVal = 7000
  387. Dim mCD As Boolean
  388. Dim mWave As Boolean
  389. Dim mMidi As Boolean
  390. Dim mTracks As Integer
  391. Dim hmixer As Long
  392. Dim volCtrl As MIXERCONTROL    ' waveout volume control
  393. Dim micCtrl As MIXERCONTROL    ' microphone volume control
  394. Dim rc As Long
  395. Dim OK As Boolean
  396. Dim VolSetting As VOLSETTINGTYPE
  397. Dim mVol As VOLTYPE
  398. Dim LeftVol As Double, RightVol As Double
  399. Dim q As String, mSign As String
  400. Dim id As Long, mWaveVol As Long
  401. '-------
  402. Dim gmixervolume As Long
  403. Dim gfso As FileSystemObject
  404. Dim gcdg As Object
  405. Private Sub Form_Load()
  406.      mCD = False
  407.      mWave = False
  408.      mMidi = False
  409.      ButtonsOn True
  410.        ' Tentatively set a reasonable starting volume level first
  411.      gmixervolume = 30000
  412.      Set gcdg = CommonDialog1
  413.      Set gfso = New FileSystemObject
  414. End Sub
  415. Private Sub cmdExit_Click()
  416.      On Error Resume Next
  417.      mmControl1.Command = "pause"
  418.      mmControl1.UpdateInterval = 0
  419.      mmControl1.To = "1"
  420.      mmControl1.Command = "Seek"
  421.      mmControl1.Command = "close"
  422.      Unload Me
  423. End Sub
  424. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  425.      On Error Resume Next
  426.      mmControl1.Command = "pause"
  427.      mmControl1.UpdateInterval = 0
  428.      mmControl1.To = "1"
  429.      mmControl1.Command = "Seek"
  430.      mmControl1.Command = "close"
  431.      Set gcdg = Nothing
  432.      Set gfso = Nothing
  433. End Sub
  434. Private Function CD_GetVolume(ByVal hmixer As Long, ByVal componentType As Long, _
  435.         ByVal ctrlType As Long, ByRef mxc As MIXERCONTROL) As Boolean
  436.                               
  437.     Dim mxlc As MIXERLINECONTROLS
  438.     Dim mxl As MIXERLINE
  439.     Dim hmem As Long
  440.     Dim rc As Long
  441.              
  442.     mxl.cbStruct = Len(mxl)
  443.     mxl.dwComponentType = componentType
  444.       
  445.         ' Obtain a line corresponding to the component type
  446.     rc = mixerGetLineInfo(hmixer, mxl, MIXER_GETLINEINFOF_COMPONENTTYPE)
  447.          
  448.     If (MMSYSERR_NOERROR = rc) Then
  449.          mxlc.cbStruct = Len(mxlc)
  450.          mxlc.dwLineID = mxl.dwLineID
  451.          mxlc.dwControl = ctrlType
  452.          mxlc.cControls = 1
  453.          mxlc.cbmxctrl = Len(mxc)
  454.             
  455.             ' Allocate a buffer for the control
  456.          hmem = GlobalAlloc(&H40, Len(mxc))
  457.          mxlc.pamxctrl = GlobalLock(hmem)
  458.          mxc.cbStruct = Len(mxc)
  459.              
  460.              ' Get the control
  461.          rc = mixerGetLineControls(hmixer, mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE)
  462.                   
  463.          If (MMSYSERR_NOERROR = rc) Then
  464.               CD_GetVolume = True
  465.                  
  466.                  ' Copy the control into the destination structure
  467.               CopyStructFromPtr mxc, mxlc.pamxctrl, Len(mxc)
  468.          Else
  469.               CD_GetVolume = False
  470.          End If
  471.          GlobalFree (hmem)
  472.          Exit Function
  473.      End If
  474.      CD_GetVolume = False
  475. End Function
  476.       
  477.       
  478.       
  479. Private Function CD_SetVolume(ByVal hmixer As Long, mxc As MIXERCONTROL, _
  480.           ByVal volume As Long) As Boolean
  481.                               
  482.      Dim mxcd As MIXERCONTROLDETAILS
  483.      Dim vol As MIXERCONTROLDETAILS_UNSIGNED
  484.       
  485.      mxcd.item = 0
  486.      mxcd.dwControlID = mxc.dwControlID
  487.      mxcd.cbStruct = Len(mxcd)
  488.      mxcd.cbDetails = Len(vol)
  489.          
  490.        ' Allocate a buffer for the control value buffer
  491.      hmem = GlobalAlloc(&H40, Len(vol))
  492.      mxcd.paDetails = GlobalLock(hmem)
  493.      mxcd.cChannels = 1
  494.      vol.dwValue = volume
  495.          
  496.        ' Copy the data into the control value buffer
  497.      CopyPtrFromStruct mxcd.paDetails, vol, Len(vol)
  498.          
  499.        ' Set the control value
  500.      rc = mixerSetControlDetails(hmixer, mxcd, MIXER_SETCONTROLDETAILSF_VALUE)
  501.          
  502.      GlobalFree (hmem)
  503.      If (MMSYSERR_NOERROR = rc) Then
  504.           CD_SetVolume = True
  505.      Else
  506.           CD_SetVolume = False
  507.      End If
  508. End Function
  509. Sub WAVE_GetVolume()
  510.     On Error Resume Next
  511.     id = -0
  512.     Dim i As Long
  513.     i = waveOutGetVolume(id, mWaveVol)
  514.     mVol.mWaveVol = mWaveVol
  515.     LSet VolSetting = mVol
  516.     LeftVol = VolSetting.LeftVol: RightVol = VolSetting.RightVol
  517.     LeftVol = LeftVol - &HFFF
  518.     RightVol = RightVol - &HFFF
  519.     If LeftVol < -32768 Then LeftVol = 65535 + LeftVol
  520.     If RightVol < -32768 Then RightVol = 65535 + RightVol
  521.     VolSetting.LeftVol = LeftVol
  522.     VolSetting.RightVol = RightVol
  523.     LSet mVol = VolSetting
  524.     mWaveVol = mVol.mWaveVol
  525.     ghtr = Left(LeftVol, 1)
  526.     If ghtr = "-" Then
  527.         GoTo NegVal
  528.     End If
  529.     q = CStr(LeftVol / PosStepVal)
  530.     If Val(q) < 1 Then q = "1"
  531.     If Val(q) > 6 Then q = "6"
  532.     Exit Sub
  533. NegVal:
  534.     q = CStr((LeftVol * -1) / NegStepVal)
  535.     If Val(q) < 7 Then q = "7"
  536.     If Val(q) > 10 Then q = "10"
  537. End Sub
  538. Private Sub ButtonsOn(Onoff As Boolean)
  539.     ' If the device is open, close it.
  540.     If Not mmControl1.Mode = vbMCIModeNotOpen Then
  541.         mmControl1.Command = "Close"
  542.     End If
  543.     cmdCDLoad.Visible = False    ' Till if cmdCD is chosen
  544.     cboTrack.Clear
  545.     cboTrack.Enabled = False
  546.     If Onoff Then
  547.          mmControl1.Visible = False
  548.          
  549.          cmdCD.Enabled = True
  550.          cmdWave.Enabled = True
  551.          cmdMidi.Enabled = True
  552.          
  553.            ' Volume
  554.          lblVolume.Visible = False
  555.          picVolume.Visible = False
  556.          cmdVolInc.Visible = False
  557.          cmdVolDec.Visible = False
  558.          
  559.          lblDevice.Caption = ""
  560.          picVolume.Visible = False
  561.          lblTotalTrack.Visible = False
  562.          cboTrack.Visible = False
  563.          
  564.          lblDuration.Visible = False
  565.          lblDurationValue.Visible = False
  566.          
  567.     Else
  568.          mmControl1.Visible = True
  569.          
  570.          cmdCD.Enabled = False
  571.          cmdWave.Enabled = False
  572.          cmdMidi.Enabled = False
  573.          
  574.          lblDuration.Visible = True
  575.          lblDurationValue.Caption = ""
  576.          lblDurationValue.Visible = True
  577.          
  578.          If mCD Then
  579.              lblTotalTrack.Caption = "Total tracks:"
  580.              lblTotalTrack.Visible = True
  581.              cboTrack.Visible = True
  582.          End If
  583.          If mCD Or mWave Then
  584.              lblVolume.Visible = True
  585.              picVolume.Visible = True
  586.              cmdVolInc.Visible = True
  587.              cmdVolDec.Visible = True
  588.          End If
  589.     End If
  590. End Sub
  591. Private Sub cmdCD_Click()
  592.     mCD = True
  593.     mWave = False
  594.     mMidi = False
  595.     lblDevice.Caption = "CD Player"
  596.     GoPlay1
  597. End Sub
  598. Private Sub cmdWave_Click()
  599.     mCD = False
  600.     mWave = True
  601.     mMidi = False
  602.     lblDevice.Caption = "WaveAudio"
  603.     GoPlay2
  604. End Sub
  605. Private Sub cmdMidi_Click()
  606.     mCD = False
  607.     mWave = False
  608.     mMidi = True
  609.     lblDevice.Caption = "Sequencer"
  610.     GoPlay2
  611. End Sub
  612. Private Sub GoPlay1()
  613.     If CDOpenMixer Then
  614.         ButtonsOn False
  615.         cmdCDLoad.Visible = True         ' Now let user see this button
  616.     End If
  617. End Sub
  618.    ' Triggered by user clicking cmdCDLoad
  619. Private Sub cmdCDLoad_Click()
  620.     ' Open the CD device -- the disc must already be in the drive.
  621.     On Error GoTo MCIerrhandler
  622.     With mmControl1
  623.          .DeviceType = "CDAudio"
  624.          .UpdateInterval = 0
  625.          .Wait = False
  626.     End With
  627.     cmdCDLoad.Visible = False      ' User will see this again if eject CD
  628.     mmControl1.TimeFormat = vbMCIFormatTmsf
  629.     mmControl1.Command = "Open"
  630.     mmControl1.Command = "pause"
  631.     mTracks = mmControl1.Tracks
  632.     mmControl1.To = "1"
  633.     mmControl1.Command = "Seek"
  634.       ' Fill list of track Nos.
  635.     Dim i As Integer
  636.     cboTrack.Clear
  637.     For i = 1 To mTracks
  638.          cboTrack.AddItem i
  639.     Next i
  640.     cboTrack.Text = cboTrack.List(0)
  641.     DispTrackDuration
  642.     mmControl1_PrevClick (0)         ' Move to very start
  643.         
  644.         
  645.     lblTotalTrack.Caption = "Total tracks: " & Str(mTracks)
  646.     cboTrack.Enabled = True
  647.     Exit Sub
  648. MCIerrhandler:
  649.     ShowMCIerr
  650.     Unload frmAudioPlayer
  651. End Sub
  652. Private Sub cbotrack_click()
  653.        ' Set cboTrack value first
  654.     cboTrack.ListIndex = Val(cboTrack.Text) - 1
  655.     DispTrackDuration
  656.     mmControl1.Command = "pause"
  657.     mmControl1.TimeFormat = mciFormatTmsf
  658.     mmControl1.To = Str$(cboTrack.ListIndex + 1)
  659.     mmControl1.Command = "Seek"
  660.     mmControl1.Track = Str$(cboTrack.ListIndex + 1)
  661.       ' Once in play, disallow cboTrack, until cmdCDLoad is clicked again
  662.     cboTrack.Enabled = False
  663.     mmControl1.Command = "Play"
  664. End Sub
  665. Private Sub DispTrackDuration()
  666.     On Error Resume Next
  667.     If mCD Then
  668.           ' Set correct Timefort to obtain milliseconds later
  669.          mmControl1.TimeFormat = mciFormatMilliseconds
  670.           ' Set track before calling to get tracklength
  671.          If Val(mmControl1.Track) <= 1 Then
  672.              mmControl1.Track = "1"
  673.          End If
  674.          mmControl1.Track = cboTrack.Text
  675.          lblDurationValue.Caption = convertmmSec(mmControl1.TrackLength)
  676.          mmControl1.TimeFormat = mciFormatTmsf
  677.     End If
  678. End Sub
  679. Private Sub GoPlay2()
  680.     On Error GoTo MCIerrhandler
  681.     ButtonsOn False
  682.       ' Obtain current Wave volume
  683.     WAVE_GetVolume
  684.       ' Set number of milliseconds between successive StatusUpdate events
  685.     mmControl1.UpdateInterval = 0
  686.     With gcdg
  687.          .CancelError = True
  688.          Select Case lblDevice.Caption
  689.              Case "WaveAudio"
  690.                  .DialogTitle = "WaveAudio"
  691.                  .Filter = "(*.wav)|*.wav"
  692.              Case "Sequencer"
  693.                  .DialogTitle = "Sequencer"
  694.                  .Filter = "(*.mid)|*.mid"
  695.          End Select
  696.          
  697.          .FilterIndex = 1
  698.          .Flags = vbOFNReadOnly Or vbOFNFileMustExist
  699.          .FileName = ""
  700.     End With
  701. FileNameRetry:
  702.     gcdg.ShowOpen
  703.     If Not gfso.FileExists(gcdg.FileName) Then
  704.         GoTo FileNameRetry
  705.     End If
  706.     Select Case UCase(lblDevice.Caption)
  707.         Case "Waveaudio"
  708.             mmControl1.DeviceType = "WaveAudio"
  709.         Case "SEQUENCER"
  710.             mmControl1.DeviceType = "Sequencer"
  711.     End Select
  712.          
  713.     With mmControl1
  714.         .FileName = gcdg.FileName
  715.            ' Allow the multimedia MCI control to stop before returning to application.
  716.         .Wait = False
  717.         .Command = "Open"
  718.         .TimeFormat = vbMCIFormatMilliseconds
  719.     End With
  720.     On Error GoTo 0
  721.     lblDurationValue.Caption = convertmmSec(mmControl1.Length)
  722.        ' Exit to continue (to play)
  723.     Exit Sub
  724. MCIerrhandler:
  725.     ButtonsOn True
  726.     If Err.Number <> 32755 Then
  727.          ShowMCIerr
  728.          Unload frmAudioPlayer
  729.     End If
  730. End Sub
  731. Private Sub mmControl1_PlayClick(Cancel As Integer)
  732.      ' Set the number of milliseconds between successive StatusUpdate events.
  733.     If mCD Then
  734.          If Val(mmControl1.Track) <= 1 Then
  735.              mmControl1.Track = "1"
  736.          End If
  737.          cboTrack.Text = cboTrack.List(Val(mmControl1.Track) - 1)
  738.          DispTrackDuration
  739.          mmControl1.UpdateInterval = conCDInterval
  740.            ' Once in play, disallow cboTrack, until cmdCDLoad is clicked again
  741.          cboTrack.Enabled = False
  742.     Else
  743.          mmControl1.UpdateInterval = conWAVEInterval
  744.     End If
  745.     mmControl1.Command = "play"
  746. End Sub
  747. Private Sub mmControl1_PrevClick(Cancel As Integer)
  748.     ' Set the number of milliseconds between successive
  749.     ' StatusUpdate events.
  750.     mmControl1.UpdateInterval = 0
  751.     mmControl1.Command = "Prev"
  752. End Sub
  753. Private Sub mmControl1_EjectClick(Cancel As Integer)
  754.     On Error GoTo MCIerrhandler
  755.       ' Since user has ejected CD, may use LoadCD button again
  756.     cmdCDLoad.Visible = True
  757.     mmControl1.UpdateInterval = 0
  758.     mmControl1.Command = "Eject"
  759.     mmControl1.Command = "Close"
  760.     On Error GoTo 0
  761.     Exit Sub
  762. MCIerrhandler:
  763.     ShowMCIerr
  764. End Sub
  765. Private Sub mmControl1_NextCompleted(ErrorCode As Long)
  766.     cboTrack.Text = cboTrack.List(mmControl1.Track - 1)
  767.     DispTrackDuration
  768. End Sub
  769. Private Sub mmControl1_PauseClick(Cancel As Integer)
  770.     mmControl1.UpdateInterval = 0
  771. End Sub
  772. Private Sub mmControl1_PrevCompleted(ErrorCode As Long)
  773.       ' By the time "completed", already in current track
  774.     cboTrack.Text = cboTrack.List(mmControl1.Track - 1)
  775.     DispTrackDuration
  776. End Sub
  777. Private Sub mmControl1_StopClick(Cancel As Integer)
  778.     If mCD = True Then
  779.          cboTrack.Text = cboTrack.List(0)
  780.          lblDurationValue.Caption = ""
  781.          mmControl1.Command = "pause"
  782.          mmControl1.UpdateInterval = 0
  783.          mmControl1.To = "1"
  784.          mmControl1.Command = "Seek"
  785.          mmControl1.Command = "close"
  786.          
  787.          cmdCDLoad.Visible = True
  788.     End If
  789. End Sub
  790. Private Sub mmControl1_StatusUpdate()
  791.     If mCD Then
  792.         ' Set the track number to the current track.
  793.         cboTrack.Text = cboTrack.List(mmControl1.Track - 1)
  794.         DispTrackDuration
  795.     Else
  796.         ' If the device is not playing, reset to the beginning.
  797.        If Not mmControl1.Mode = vbMCIModePlay Then
  798.              mmControl1.UpdateInterval = 0
  799.        End If
  800.     End If
  801. End Sub
  802. Private Sub cmdVolDec_Click()
  803.     If mCD Then
  804.         CD_DecVolumeProc
  805.     ElseIf mWave Then
  806.         WAVE_DecVolumeProc
  807.     End If
  808. End Sub
  809. Private Sub cmdVolInc_Click()
  810.     If mCD Then
  811.         CD_IncVolumeProc
  812.     ElseIf mWave Then
  813.         WAVE_IncVolumeProc
  814.     End If
  815. End Sub
  816. Private Function CDOpenMixer() As Boolean
  817.     CDOpenMixer = True
  818.       ' Open the mixer with deviceID 0.
  819.     rc = mixerOpen(hmixer, 0, 0, 0, 0)
  820.     If ((MMSYSERR_NOERROR <> rc)) Then
  821.         MsgBox "Couldn't open the mixer."
  822.         CDOpenMixer = False
  823.         Exit Function
  824.     End If
  825.              
  826.       ' Get the waveout volume control
  827.     OK = CD_GetVolume(hmixer, MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, _
  828.               MIXERCONTROL_CONTROLTYPE_VOLUME, volCtrl)
  829.     If (OK = True) Then
  830.         ' If the function successfully gets the volume control,
  831.         ' the maximum and minimum values are specified by
  832.         ' lMaximum and lMinimum
  833.         Label1.Caption = volCtrl.lMinimum & " to " & volCtrl.lMaximum
  834.     End If
  835.             
  836.         ' Get the microphone volume control
  837.     OK = CD_GetVolume(hmixer, MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE, _
  838.              MIXERCONTROL_CONTROLTYPE_VOLUME, micCtrl)
  839.  End Function
  840.       
  841.       
  842.  Private Sub CD_DecVolumeProc()
  843.      On Error Resume Next
  844.      Dim cdvol As Long
  845.      cdvol = gmixervolume - VolStelVal
  846.      If cdvol < volCtrl.lMinimum Then
  847.          cdvol = volCtrl.lMinimum
  848.      End If
  849.      CD_SetVolume hmixer, volCtrl, cdvol
  850.      gmixervolume = cdvol
  851.  End Sub
  852.       
  853.       
  854.       
  855.  Private Sub CD_IncVolumeProc()
  856.      On Error Resume Next
  857.      Dim cdvol As Long
  858.      cdvol = gmixervolume + VolStelVal
  859.      If cdvol > volCtrl.lMaximum Then
  860.          cdvol = volCtrl.lMaximum
  861.      End If
  862.      CD_SetVolume hmixer, volCtrl, cdvol
  863.      gmixervolume = cdvol
  864.  End Sub
  865. Private Sub WAVE_DecVolumeProc()
  866.     On Error Resume Next
  867.     If q = "1" Then
  868.         Exit Sub
  869.     End If
  870.     id = -0
  871.     Dim i As Long
  872.     i = waveOutGetVolume(id, mWaveVol)
  873.     mVol.mWaveVol = mWaveVol
  874.     LSet VolSetting = mVol
  875.     LeftVol = VolSetting.LeftVol: RightVol = VolSetting.RightVol
  876.     LeftVol = LeftVol - &HFFF
  877.     RightVol = RightVol - &HFFF
  878.     If LeftVol < -32768 Then LeftVol = 65535 + LeftVol
  879.     If RightVol < -32768 Then RightVol = 65535 + RightVol
  880.     VolSetting.LeftVol = LeftVol
  881.     VolSetting.RightVol = RightVol
  882.     LSet mVol = VolSetting
  883.     mWaveVol = mVol.mWaveVol
  884.     i = waveOutSetVolume(id, mWaveVol)
  885.     WAVE_GetVolume
  886. End Sub
  887. Private Sub WAVE_IncVolumeProc()
  888.     On Error Resume Next
  889.     If q = "10" Then
  890.         Exit Sub
  891.     End If
  892.     Dim dfre
  893.     id = -0
  894.     Dim i As Long
  895.     i = waveOutGetVolume(id, mWaveVol)
  896.     mVol.mWaveVol = mWaveVol
  897.     LSet VolSetting = mVol
  898.     LeftVol = VolSetting.LeftVol: RightVol = VolSetting.RightVol
  899.     LeftVol = LeftVol + &HFFF
  900.     RightVol = RightVol + &HFFF
  901.     'If LeftVol <= -30000 Then Exit Sub
  902.     If LeftVol > 32767 Then LeftVol = LeftVol - 65536
  903.     If RightVol > 32767 Then RightVol = RightVol - 65536
  904.     VolSetting.LeftVol = LeftVol
  905.     VolSetting.RightVol = RightVol
  906.     LSet mVol = VolSetting
  907.     mWaveVol = mVol.mWaveVol
  908.     i = waveOutSetVolume(id, mWaveVol)
  909.     WAVE_GetVolume
  910. End Sub
  911. Private Sub ShowMCIerr()
  912.     Dim msg As String
  913.     Select Case Err
  914.         Case conMCIErrCannotLoadDriver
  915.             msg = "Error load media device driver."
  916.         Case conMCIErrDeviceOpen
  917.             msg = "The device is not open or is not known."
  918.         Case conMCIErrInvalidDeviceID
  919.             msg = "Invalid device id."
  920.         Case conMCIErrInvalidDeviceID
  921.             msg = "Invalid filename."
  922.         Case conMCIErrUnsupportedFunction
  923.             msg = "Action not available for this device."
  924.         Case Else
  925.             msg = "Unknown error (" + Str$(Err) + ")."
  926.     End Select
  927.     MsgBox msg, 48, conMCIAppTIitle
  928. End Sub
  929. Private Function convertmmSec(ByVal TimeIn As Long) As String
  930.     Dim intH As Integer, intM As Integer, intS As Integer
  931.     Dim tmp As Long
  932.     Dim strTime As String
  933.     tmp = TimeIn / 1000
  934.     intH = Int(tmp / 3600)
  935.     tmp = tmp Mod 3600
  936.     intM = Int(tmp / 60)
  937.     tmp = tmp Mod 60
  938.     intS = tmp
  939.     If intH > 0 Then
  940.         strTime = Trim(Str(intH)) & ":"
  941.     Else
  942.         strTime = ""
  943.     End If
  944.     If intM >= 10 Then
  945.         strTime = strTime & Trim(Str(intM))
  946.     ElseIf intM > 0 Then
  947.         strTime = strTime & "0" & Trim(Str(intM))
  948.     Else
  949.         strTime = strTime & "00"
  950.     End If
  951.     strTime = strTime & ":"
  952.     If intS >= 10 Then
  953.         strTime = strTime & Trim(Str(intS))
  954.     ElseIf intS > 0 Then
  955.         strTime = strTime & "0" & Trim(Str(intS))
  956.     Else
  957.         strTime = strTime & "00"
  958.     End If
  959.     convertmmSec = strTime
  960. End Function
  961.